home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / EXPAND.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  50KB  |  1,819 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. #define GEN
  10.  
  11. #include "hdr.h"
  12. #include "libhdr.h"
  13. #include "vars.h"
  14. #include "gvars.h"
  15. #include "attr.h"
  16. #include "slot.h"
  17. #include "segment.h"
  18. #include "setp.h"
  19. #include "langp.h"
  20. #include "initp.h"
  21. #include "initobjp.h"
  22. #include "dbxp.h"
  23. #include "miscp.h"
  24. #include "utilp.h"
  25. #include "glibp.h"
  26. #include "readp.h"
  27. #include "libp.h"
  28. #include "arithp.h"
  29. #include "librp.h"
  30. #include "gnodesp.h"
  31. #include "gmiscp.h"
  32. #include "gutilp.h"
  33. #include "aggrp.h"
  34. #include "chapp.h"
  35. #include "smiscp.h"
  36. #include "gmainp.h"
  37. #include "expandp.h"
  38.  
  39. void expand(Node node)                                                /*;expand*/
  40. {
  41.     /*
  42.      * Expander
  43.      * Performs a set of semantic transformations on the tree
  44.      * in order to simplify the job for the code generator.
  45.      * Some semantic optimizations are performed too.
  46.      * IMPORTANT: 
  47.      *    expand must not be called twice on the same structure, as
  48.      *    for some kinds of nodes, the format before expand is
  49.      *    different from the format after expand. A special problem
  50.      *    arises for aggregates, where already expanded structures
  51.      *    (subaggregates) are part of a not yet expanded structure
  52.      *    (assignment to enclosing structure) that must be expanded.
  53.      *    a special node, as_expanded, is used to block double
  54.      *    expansion in that case.
  55.      */
  56.  
  57.     Fortup      ft1, ft2;
  58.     Tuple       tup, tup1, tup2;
  59.     Symbolmap   instance_map, type_map;
  60.     Node        node1, node2, node3, node4;
  61.     Symbol      sym1, sym2, sym3, sym4;
  62.     int         nk, cboolean;
  63.     Const       lv;
  64.     Unitdecl    ud;
  65.  
  66.     /* TBSL remove the following declarations */
  67.     Const       lbd_1, ubd_1, lbd_2, ubd_2;
  68.     int         ubd_1_val, ubd_2_val, lbd_1_val, lbd_2_val;
  69.  
  70.     Tuple  instantiation_code, ntup ;
  71. #ifdef TRACE
  72.     if (debug_flag)
  73.         gen_trace_node("EXPAND", node);
  74. #endif
  75.  
  76. #ifdef DEBUG
  77.     if (trapns>0 && N_SEQ(node)== trapns && N_UNIT(node) == trapnu) trapn(node);
  78. #endif
  79.     switch N_KIND(node) {
  80.  
  81.     case(as_insert):
  82.         N_SIDE(node) = FALSE;
  83.         FORTUP(node1 = (Node), N_LIST(node), ft1);
  84.             expand(node1);
  85.             N_SIDE(node) |= N_SIDE(node1);
  86.         ENDFORTUP(ft1);
  87.         node1 = N_AST1(node);
  88.         expand(node1);
  89.         N_SIDE(node) |= N_SIDE(node1);
  90.         break;
  91.  
  92.     /* Chapter 3. Declarations and types*/
  93.     /*
  94.      *-----------------
  95.      * 3.1 Declarations
  96.      */
  97.     case(as_declarations):
  98.         N_SIDE(node) = FALSE;
  99.         if (N_LIST(node) == (Tuple)0)
  100.             chaos("expand.c: as_declarations N_LIST null");
  101.         FORTUP(node1 = (Node), N_LIST(node), ft1);
  102.             expand(node1);
  103.             N_SIDE(node) |= N_SIDE(node1);
  104.         ENDFORTUP(ft1);
  105.         break;
  106.  
  107.     /*
  108.      *------------------------------
  109.      * 3.2 Objects and named numbers
  110.      */
  111.  
  112.     case(as_obj_decl):
  113.     case(as_const_decl):
  114.         expand_decl(node);
  115.         break;
  116.  
  117.     /*
  118.      *-----------------------
  119.      * 3.3 Types and subtypes
  120.      * 3.3.1
  121.      */
  122.     case(as_type_decl):
  123.         expand_type(node);
  124.         break;
  125.  
  126.     /* 3.3.2 */
  127.     case(as_subtype_decl):
  128.     expand_subtype(node);
  129.         break;
  130.  
  131.     case(as_delayed_type):
  132.         sym1 = N_UNQ(N_AST1(node)); /* type name */
  133.         sym2 = N_UNQ(N_AST2(node)); /* parent name */
  134.         node1 = copy_node(node);    /* delayed node */
  135.         if (NATURE(sym1) == na_subtype)
  136.             N_KIND(node1) = as_subtype_decl;
  137.         else
  138.             N_KIND(node1) = as_type_decl;
  139.         nk = emap_get(sym2); 
  140.         tup = EMAP_VALUE;
  141.         if (!nk)  /* emap_defined */
  142.             tup = tup_new1((char *) node1);
  143.         else
  144.             tup = tup_with(tup, (char *)node1);
  145.         /* EMAP(sym2) = (EMAP(sym2)?[]) with node1;*/
  146.         emap_put(sym2, (char *) tup);
  147.         delete_node(node);
  148.         break;
  149.  
  150.     case(as_subtype_indic):
  151.         sym1 = N_UNQ(N_AST1(node)); /* type name */
  152.         N_SIDE(node) = (unsigned)CONTAINS_TASK(sym1);
  153.         node2 = N_AST2(node); /* expression */
  154.         expand(node2);
  155.         N_SIDE(node) |= N_SIDE(node2);
  156.         break;
  157.     /*
  158.      *-----------------
  159.      * 3.5 Scalar types
  160.      */
  161.     case(as_digits):
  162.         expand(N_AST1(node)); /* precision node */
  163.         node2 = N_AST2(node); /* range node */
  164.         expand(node2);
  165.         N_SIDE(node) = N_SIDE(node2);
  166.         break;
  167.  
  168.     case(as_delta):
  169.         expand(N_AST1(node)); /* precision node */
  170.         node2 = N_AST2(node); /* range node */
  171.         expand(node2);
  172.         N_SIDE(node) = N_SIDE(node2);
  173.         break;
  174.  
  175.     case(as_subtype):
  176.         node2 = N_AST2(node);
  177.         expand(node2);
  178.         N_SIDE(node) = N_SIDE(node2);
  179.  
  180.         /* Transmit tasks_declared: */
  181.         sym1 = N_UNQ(N_AST1(node)); /* type name */
  182.         /* N_TYPE(node) is parent type */
  183.         CONTAINS_TASK(sym1) = CONTAINS_TASK(N_TYPE(node));
  184.         break;
  185.  
  186.     case(as_component_list):
  187.         node1 = N_AST1(node); /* invariant node */
  188.         FORTUP(node2 = (Node), N_LIST(node1), ft1);
  189.             expand(node2);     /* field node */
  190.         ENDFORTUP(ft1);
  191.         expand(N_AST2(node)); /* variant node */
  192.         N_SIDE(node) = FALSE;
  193.         break;
  194.  
  195.     case(as_simple_choice):
  196.         node1 = N_AST1(node); /* expression */
  197.         expand(node1);
  198.         N_SIDE(node) = N_SIDE(node1);
  199.         break;
  200.  
  201.     case(as_incomplete_decl):
  202.         sym1 = N_UNQ(N_AST1(node)); /* type name */
  203.         CONTAINS_TASK(sym1) = (char *) TRUE; /* May be. Future will tell */
  204.         delete_node(node);
  205.         break;
  206.  
  207.     /*
  208.      * Chapter 4. Names and expressions
  209.      *
  210.      *----------
  211.      * 4.1 Names
  212.      */
  213.     case(as_range_choice):
  214.         node1 = N_AST1(node);
  215.         if (N_KIND(node1) == as_attribute) {
  216.             /* must be range. */
  217.             sym1 = N_TYPE(node1);
  218.             nk = (int)attribute_kind(node1) - ATTR_RANGE;   /* 'T' or 'O'*/
  219.             attribute_kind(node1) = (char *) (nk + ATTR_FIRST);
  220.             N_AST2(node) = new_attribute_node(nk + ATTR_LAST,
  221.               N_AST2(node1), N_AST3(node1), sym1);
  222.             N_KIND(node) = as_range;
  223.             N_TYPE(node) = sym1;
  224.             expand(node);
  225.         }
  226.         else {
  227.             node2 = N_AST2(node1);
  228.             expand(node2);
  229.             N_SIDE(node) = N_SIDE(node2);
  230.         }
  231.         break;
  232.  
  233.     case(as_range):
  234.         node1 = N_AST1(node); /* expression */
  235.         node2 = N_AST2(node); /* expression */
  236.         expand(node1);
  237.         expand(node2);
  238.         N_SIDE(node) = N_SIDE(node1) | N_SIDE(node2);
  239.         break;
  240.  
  241.     case(as_constraint):
  242.         N_SIDE(node) = FALSE;
  243.         FORTUP(node1 = (Node), N_LIST(node), ft1);
  244.             if (N_KIND(node1) == as_choice_list) {
  245.                 /* named discriminant constraints. Only need expression. */
  246.                 node1 = N_AST2(node1) ;
  247.             }
  248.             expand(node1);
  249.             N_SIDE(node) |= N_SIDE(node1);
  250.         ENDFORTUP(ft1);
  251.         break;
  252.  
  253.     case(as_index):
  254.         node1 = N_AST1(node) ; /* array node */
  255.         expand(node1);
  256.         N_SIDE(node) = N_SIDE(node1);
  257.         /* N_AST2(node) is a list of indices */
  258.         FORTUP(node2 = (Node), N_LIST(N_AST2(node)), ft1);
  259.             expand(node2); /* index */
  260.             N_SIDE(node) |=  N_SIDE(node2);
  261.         ENDFORTUP(ft1);
  262.         break;
  263.  
  264.     /*
  265.      * 4.1.2
  266.      */
  267.     case(as_slice):
  268.         node2 = N_AST2(node) ; /* range node */
  269.  
  270.         if (N_KIND(node2) == as_subtype) {
  271.             /* remove subtype */
  272.             node1 = N_AST2(node2); /* id node */
  273.             copy_attributes(node1, node2);
  274.         }
  275.  
  276.         if (is_simple_name(node2)) {
  277.             /* type name replaced by range attribute */
  278.             /* SETL has OPT_NODE as third arg in next call. This is
  279.               * wrong - want to indicate first dimension.
  280.               *  ds    9-8-85
  281.               */
  282.             node2 = new_attribute_node(ATTR_T_RANGE, node2,
  283.               new_ivalue_node(int_const(1), symbol_integer), N_UNQ(node2));
  284.             N_AST2(node) = node2 ;
  285.         }
  286.         node1 = N_AST1(node) ; /* array node */
  287.         expand(node1);
  288.         N_SIDE(node) = N_SIDE(node1);
  289.         expand(node2);         /* range node */
  290.         N_SIDE(node) |= N_SIDE(node2);
  291.         break;
  292.  
  293.     case(as_field):
  294.         node2 = N_AST2(node) ; /* expression */
  295.         expand(node2);
  296.         N_SIDE(node) = N_SIDE(node2);
  297.         break;
  298.  
  299.     case(as_selector):
  300.     case(as_all):
  301.         node1 = N_AST1(node) ; /* expression */
  302.         expand(node1);
  303.         N_SIDE(node) = N_SIDE(node1);
  304.         break;
  305.  
  306.     /*
  307.      * 4.1.4
  308.      */
  309.     case(as_attribute):
  310.     case(as_range_attribute):
  311.         expand_attr(node);
  312.         break;
  313.  
  314.     /*
  315.      *-------------
  316.      * 4.2 Literals
  317.      */
  318.     case(as_string_ivalue):
  319.         expand_string(node);
  320.         break;
  321.  
  322.     case(as_int_literal):
  323.         /* TBSL(JC) This is a kludge */
  324.         N_KIND(node) = as_ivalue;
  325.         lv = adaval(symbol_integer, N_VAL(node));
  326.         if (adaval_overflow)
  327.             chaos("unable to convert integer literal");
  328.         else
  329.             N_VAL(node) = (char *) lv;
  330.         N_SIDE(node) = FALSE;
  331.         break;
  332.  
  333.     /*
  334.      *---------------
  335.      * 4.3 Aggregates
  336.      */
  337.     case(as_array_aggregate):
  338. #ifdef DEFER
  339.         /* N_LIST assignmentnot needed in packed version  DS 3-86 */
  340.         N_LIST(node) = (Tuple)0;    /* Useless information removed */
  341. #endif
  342.         expand_array_aggregate(node) ;
  343.         N_SIDE(node) = N_KIND(node) != as_array_ivalue;
  344.         /* TBSL